home *** CD-ROM | disk | FTP | other *** search
/ 100 Great Games for Palm OS 1 / 100PalmV1.iso / Casino / pocket poker / ppoker10.csl < prev    next >
Text File  |  1998-07-19  |  52KB  |  2,149 lines
  1. # ppoker10.csl, version 1.0
  2.  
  3. # Frank O'Brien
  4.  
  5. # Copyright (C) July 1998, Frank O'Brien,
  6. #  dianfrank@worldnet.att.net.
  7. #
  8. # Absolutely no warranty is given by author.
  9. #
  10. # The author has put a few hours into this program, as well as 
  11. #  invested in the CASL development environment, and therefore would 
  12. #  like to recover a small token in return from those users so moved.  
  13. #  On the other hand, the author also wishes to contribute free of charge 
  14. #  the source code to the CASL development community, for any help it may 
  15. #  offer to new developers.  This results in a rather unique hybrid 
  16. #  shareware/freeware distribution policy.
  17. #
  18. # 1. The original PRC file may be distributed as $12 shareware.
  19.  
  20. # 2. The CSL source file and the CIC icon files may be distributed 
  21. #  under the following conditions:
  22. #
  23. # a. The compiled PRC version of this original source code file is 
  24. #  distributed by the original author as $12 shareware.  There shall be 
  25. #  no other commercial use of this source code file.
  26. #
  27. # b. Source code may be changed and distributed.  Distributed changes 
  28. #  shall be documented with name, type and date.  Please also add a note 
  29. #  to about box.
  30. #
  31. # c. You may distribute this source code file (with or without changes) 
  32. #  to other owners of the CASL compiler for their use.  The PRC file is 
  33. #  not to be included, except as specified below.
  34. #
  35. # d. Distribution of the compiled PRC version of changes to this source 
  36. #  code is allowed to a maximum of 20 people, and must be at no fee.  
  37. #  This is intended to allow an author to distribute changes to a small 
  38. #  group of friends, even if they do not own the CASL compiler.  Posting 
  39. #  to the Internet for unrestricted downloading is automatically assumed 
  40. #  to violate the maximum 20 requirement, and therefore is not allowed.
  41.  
  42. # requires CASL runtime module 2.5x.
  43.  
  44. # when compiling this file, FOPP has been reserved as
  45. #  a unique creator ID.  PocketPoker is intended (pilot) 
  46. #  "desktop name".  ppoker.cic is the intended icon file.
  47.  
  48. # fob 24Jun98
  49. # first attempt at poker, deal 5 cards,
  50. #  recognize hand
  51. # fob 29jun98
  52. # worked on display and play state loop, finished ante and reconcile bet
  53. # fob 30jun98
  54. # completed play loop calling structure, all buttons and functions are 
  55. #  there, but functions are skeleton
  56. # fob 1jul98
  57. # started filling in some of the play functions, do all except betting 
  58. #  cycles
  59. # fob 3jul98
  60. # finished dealer selecting which cards to discard
  61. # added bet form, filled in betting cycles, but dealer only passes or 
  62. #  folds, no raises
  63. # fob 4jul98
  64. # added graphical card display
  65. # use lbDWhat as shuffle, and other computing delay messages
  66. # clear discard display while new cards coming
  67. # show bet on main form after each bet
  68. # make dealer bet functions more sophisticated
  69. # add bluff to 2nd dealer bet round
  70. # dress up bet form, fixed selector with multiple selections highlighted
  71. # fob 5jul98
  72. # fixed bug during 1st bet round dealer rank not correct, wrong hand
  73. # added lots more comments
  74. # tweaked DDealerBet1, DDealerBet2 desired hand ranks
  75. # made bet input form relative to ante and houselimit
  76. # added welcome screen
  77. # version 0.1 released
  78.  
  79. # start of version 0.2
  80. # fob 6jul98
  81. # changed checkbox meaning to [x]=hold, [ ]=discard, due to user feedback
  82. # added help screen with basic play and hand rank instructions
  83.  
  84. # start of version 0.3
  85. # fob 8jul98
  86. # minor fixes:
  87. # dealer accepts bet. check keepers - clear this before doing 1st rank, 
  88. #  2nd round
  89. # spell shuffling right
  90. # in 2nd round, dealer is raising 200 with existing bet of 470.  before 
  91. #  that bet was 10+60 (user 1st round)+100 (user 2nd round)+200 (dealer 
  92. #  2nd round)+100 (user 2nd round).
  93. # let dealer only bet in increments of ante.
  94.  
  95. # start of version 0.4
  96. # fob 10jul98
  97. # minor fixes
  98. # in dealdraw, clear discarded cards first, then deal new cards, looks
  99. #  better, especially if shuffle happens
  100. # show bet (ante) after hit deal button, don't wait until bet screen.
  101. # add view off option for user draw recommendation
  102. # fix bug where if have ace can hold any card and draw 4
  103. # tried, doesn't work - maybe if use lines for cards, not rectangle, 
  104. #  don't need redraw after frame show swap
  105. # add help msg when check card ok button fails
  106.  
  107. # start of version 0.5
  108. # fob 11jul98
  109. # add option to change display units and houselimit
  110.  
  111. # start of version 0.6
  112. # fob 19jul98
  113. # add option to shuffle at each game start, or only when necessary
  114. # added shareware/freeware licence and conditional compile
  115. # released as version 1.0
  116.  
  117. # to do
  118. # make dealer draw selector recognize almost straight, almost flush
  119. # optimize hand ranker
  120. # detect straights with low ace
  121. # add sound
  122. # add preferences, high score, and last score databases
  123. # add dealer preferences database
  124.  
  125. # POKER STATE DIAGRAM
  126.  
  127. # key: []=tap to call invoker function, ()=program action leading to new state,
  128. #      R=dealer raise, B=bet round
  129.  
  130. # [btDeal] --> AnteUp --> Deal, clr R=0, clr B=0 --> 
  131. #
  132. # UserBetPrep --> [btBet], [slBDigit0], [slBDigit1], [btBOK], if B=0 --> DDealerBet1
  133. # UserBetPrep --> [btPass], if R=0 and B=0 --> DDealerBet1
  134. # UserBetPrep --> [btPass], if R=1 and B=0 --> UserDrawSelectPrep 
  135. # UserBetPrep --> [btFold] --> ReconcileBet
  136. #
  137. # DDealerBet1  --> (Bet), set R=1 --> UserBetPrep
  138. # DDealerBet1  --> (Pass) --> UserDrawSelectPrep
  139. # DDealerBet1  --> (Fold) --> ReconcileBet
  140. #
  141. # UserDrawSelectPrep --> [ckHold], [btOK] --> DealerDrawSelect -->
  142. #  --> DealDraw, clr R=0, set B=1 -->
  143. #
  144. # UserBetPrep --> [btBet], [slBDigit0], [slBDigit1], [btBOK], if B=1 --> DDealerBet2
  145. # UserBetPrep --> [btPass], if R=0 and B=1 --> DDealerBet2
  146. # UserBetPrep --> [btPass], if R=1 and B=1 --> ReconcileBet 
  147. # UserBetPrep --> [btFold] --> ReconcileBet
  148. #
  149. # DDealerBet2  --> (Bet), set R=1 --> UserBetPrep
  150. # DDealerBet2  --> (Pass) --> ReconcileBet
  151. # DDealerBet2  --> (Fold) --> ReconcileBet
  152. #
  153. # ReconcileBet --> [btDeal]
  154.  
  155. # POKER RANK ALGORITHM
  156.  
  157. # basically a hexadecimal number is assigned to a poker hand, where the better
  158. #  hand is always the higher number.  Technique seen in in article by Dick Pountain, 
  159. #  Byte magazine, Jul91,
  160. #
  161. # the code:
  162. #
  163. # element no. d0     d1     d2     d3     d4     d5
  164. # hand
  165. #
  166. # no hand     0      card5  card4  card3  card2  card1
  167. # pair        1      pair   odd3   odd2   odd1   0
  168. # 2 pair      2      pair1  pair2  odd1   0      0
  169. # 3 kind      3      three  odd2   odd1   0      0
  170. # straight    4      card5  0      0      0      0
  171. # flush       5      card5  card4  card3  card2  card1
  172. # full house  6      three  two    0      0      0
  173. # 4 kind      7      four   odd1   0      0      0
  174. # str-flush   8      card5  0      0      0      0
  175. #
  176. # where cardn, pairn, three, four, oddn is 2-14 value of card (2=2...j=11,q=12,k=13,a=14)
  177. #
  178. # rank = d0*16^5 + d1*16^4 + d2*16^3 + d3*16^2 + d4*16^1 + d5*16^0
  179. #
  180. # advantages: once ranked allows easy comparison of hands without alot of nested if/then's
  181. # disadvantages: doesn't differentiate between same hands by suit, so considered tie
  182. #  (very rare)
  183.  
  184. # DEALER PERSONALITY
  185.  
  186. # the dealer's personality comes out during two betting rounds, and constants are provided
  187. #  to customize the dealer's decision making process.
  188. # during each betting round, the dealer classifies its hand into "good", "ok", or "bad".
  189. # based on minimum hand ranks.  once the class is known, it has a maximum bet in mind.
  190. # the minimum hand rank for each class, and maximum bet limit depends on which betting 
  191. #  round it is in.
  192. # during round 1 and round 2, if it has a good hand, and the max bet limit has not been
  193. #  exceeded, it will propose a raise.  if it has an ok or bad hand and the max bet limit 
  194. #  is not exceeded, it will stay.  with an ok or bad hand, if the max bet limit is 
  195. #  exceeded, it will fold.
  196. # during round 2 if it chooses to bluff, it will propose a raise based on the good 
  197. #  hand limit, irrespective of what hand rank it has.
  198. # to adjust max bet limits, see nMaxGoodBet, nMaxOKBet, and nMaxBadBet.  nMaxGoodBet is 
  199. #  the house limit.
  200. # to adjust min hand limits in round 1 for good hand, see nMinGoodRank1[], 
  201. #  for ok hand, see nMinOKRank1[].
  202. # to adjust min hand limits in round 2 for good hand, see nMinGoodRank2[], 
  203. #  for ok hand, see nMinOKRank2[].
  204. # see Poker Rank explanation for how to define array elements,
  205. # to adjust bluffing rate, see nPercentBluff.
  206. # max bet variables are initialized in DInitMaxBet, all other preference variables
  207. #  are initialized in variables section.
  208. # for actual use of these constants see functions, DDealerBet1 and DDealerBet2.
  209. #
  210. # what's not customizable is withdraw card selection.  this is done by poker ranker 
  211. #  functions.  any decisions are hard coded.  the user is presented with the 
  212. #  ranker's recommendations when the user must discard.  the dealer always takes
  213. #  the ranker's recommendation.
  214.  
  215. # GLOBAL VARIABLES
  216.  
  217. variables;
  218.     bFreeware=true();
  219.     bRegistered=false();
  220. end;
  221.  
  222. # GRAPHIC VARIABLES
  223.  
  224. variables;
  225.     nPx=1000/160; # 6.25 casl pixels = 1 real pilot pixel, 1000x1000 vs. 160x160
  226.     # this could be used for accessing 40 x 40 grid
  227.     nSp=4*nPx; # 25 = nice even increment for both pilot and casl
  228.     # this make the grid effectively 36 x 36
  229.     nT=4*nSp; # 100 = top margin so don't overwrite frame heading
  230.     nL=2*nSp; # 50 = left margin
  231.     # objects sized with these will fit on a 5 x 9 grid
  232.     nH=3*nSp; # 75 = height for objects, fits normal font
  233.     nSH=nSp; # 25 = vertical spacing between objects
  234.     nW=6*nSp; # 150 = width for objects, fits short words and cards
  235.     nSW=nSp; # 25 = hortizontal spacing between objects
  236.     # objects sized with this new width will fit on a 4 x 9 grid
  237.     nWW=8*nSp; # 200 = wide width for objects, fits longer words
  238.     # could use for fitting object onto a 7 x 9 grid, but not used this way
  239.     nNW=4*nSp; # 100 = narrow width for objects, fits very short words
  240. end;
  241.  
  242. # CARD VARIABLES
  243.  
  244. variables;
  245.     # deck constants
  246.     numeric nShufs=10;
  247.     numeric nShufCards=10;
  248.     numeric nLastCard=52;
  249.     # deck variables
  250.     numeric nDeck[nLastCard];
  251.     numeric nNextCard; # index for deck array
  252. end;
  253.  
  254. # POKER PLAYING VARIABLES
  255.  
  256. variables;
  257.     #numeric nTestHand[5]=0*13+9,1*13+9,2*13+9,3*13+9,2*13+8;
  258.     # user hand variables
  259.     numeric nHand[5];
  260.     numeric nRank[1];  # single element array used so can pass by reference
  261.     string sRank[1];   #
  262.     numeric bHold[5];
  263.     # dealer hand variables
  264.     numeric nDHand[5];
  265.     numeric nDRank[1];
  266.     string sDRank[1];
  267.     numeric bDHold[5];
  268.     # accounting constants
  269.     nAnte=1;
  270.     nBank=200;
  271.     # accounting variables, set by user preference
  272.     #  all money is multiplied by units before display
  273.     numeric nUnits; # with units=10, bank=2000, for example
  274.     numeric nHouseLimit; # max. units each bet round
  275.     # accounting variables, measured in units
  276.     numeric nTempBet;
  277.     numeric nBet;
  278.     numeric nTotal;
  279.     # system flags, t/f
  280.     numeric bFold; # user folded
  281.     numeric bDFold; # dealer folded
  282.     numeric bRound2; # round 2 betting
  283.     numeric bDRaise; # dealer proposes raise
  284.     # system variables
  285.     numeric nForm;  # 0=main,1=betinput,2=pref,3=help,4=about
  286.     numeric nPriorForm;
  287.     numeric nPriorPriorForm;
  288. end;
  289.  
  290. # DEALER PERSONALITY VARIABLES
  291.  
  292. variables;
  293.     #  max bets
  294.     numeric nMaxGoodBet; # must not exceed house limit
  295.     numeric nMaxOKBet;
  296.     numeric nMaxBadBet;
  297.     # min hands
  298.     nMinGoodRank1[6]=1,11,0,0,0,0; # pair of J's
  299.     nMinOKRank1[6]=0,14,0,0,0,0; # ace high
  300.     nMinGoodRank2[6]=2,7,2,0,0,0; # pair 7's and pair 2's
  301.     nMinOKRank2[6]=1,7,0,0,0,0; # pair 7's
  302.     #  percent time will bluff by proposing raise on second round
  303.     nPercentBluff=20;
  304. end;
  305.  
  306. # VARIABLES, BET INPUT FORM
  307.  
  308. variables;
  309.     sBetSelect[10]="0","1","2","3","4","5","6","7","8","9";
  310.     numeric nBExp0;
  311.     numeric nBExp1;
  312. end;
  313.  
  314. # VARIABLES, MESSAGE FORM
  315.  
  316. variables;
  317.     string sMAbout1="PocketPoker 1.0"+
  318.      char(10)+char(10)+"Play five card draw poker against "+
  319.      "the PalmPilot."+
  320.      char(10)+char(10)+"Requires CASLrt 2.5x."+
  321.      char(10)+char(10)+"Uses poker hand ranking technique seen in "+
  322.      "article by Dick Pountain, Byte magazine, July 1991";
  323.     # 2nd variable needed to meet 255 char compile time limit
  324.     string sMAbout2=char(10)+char(10)+char(169)+
  325.      " July 1998, Frank O'Brien, "+
  326.      "dianfrank@worldnet.att.net.";
  327.     compile_if bFreeWare;
  328.         string sMAbout3=char(10)+char(10)+"Freeware when distributed "+
  329.          "as source code to CASL development community.  For details, "+ 
  330.          "see PPokerDoc.htm.  For updates, visit ";
  331.         string sMAbout4="http://home.att.net/~dianfrank/ppoker.htm.";
  332.     compile_else;
  333.         compile_if bRegistered;
  334.             string sMAbout3=char(10)+char(10)+"Registered "+
  335.              "version.  Thank you.  Updates will be automatically emailed.  Please visit, ";
  336.             string sMAbout4="http://home.att.net/~dianfrank/pilot_apps.htm "+
  337.              "for other available programs.";
  338.         compile_else;
  339.             string sMAbout3=char(10)+char(10)+"$12 shareware. Unregistered "+
  340.              "version.  If you like it, please visit, ";
  341.             string sMAbout4="http://home.att.net/~dianfrank/ppoker.htm "+
  342.              "for updates and payment methods.";
  343.         compile_end_if;
  344.     compile_end_if;
  345.     string sMHelp="Basic play: get 5 cards, bet, hold at least 2 cards "+
  346.      "(1 ace), you'll get new cards, bet again, highest hand wins"+
  347.      char(10)+char(10)+"Hand rank:"+char(10)+"Straight-Flush"+
  348.      char(10)+"4 of a kind"+char(10)+"Full house"+char(10)+
  349.      "Flush"+char(10)+"Straight"+char(10)+"3 of a kind"+char(10)+
  350.      "2 pair"+char(10)+"1 pair"+char(10)+"High card"+
  351.      char(10)+char(10)+"See PPokerDoc.htm for further details.";
  352. end;
  353.  
  354. # VARIABLES, USER PREFERENCES
  355.  
  356. variables;
  357.     numeric bAllowPrefs;
  358.     numeric bRecommendHold; # show recommended hold cards
  359.     numeric bAtStart; # when to shuffle
  360.     string sUnits[6]="1","2","5","10","20","50";
  361.     string sHouseLimit[3]="10","20","50";
  362.     # default index for nUnits and nHouseLimit
  363.     numeric nUnitsI;
  364.     numeric nHouseLimitI;
  365. end;
  366.  
  367. # OBJECTS
  368.  
  369. # OBJECTS, MAIN FORM
  370.  
  371. frame frMain;
  372.     display "PocketPoker";
  373. end;
  374.  
  375. label lbCard[5], frMain;
  376.     font "largefont","",0;
  377.     pixel_size nW-2*nPx, nH+nSH;
  378.     display "";
  379. end;
  380.  
  381. label lbDCard[5], frMain;
  382.     font "largefont","",0;
  383.     pixel_size nW-2*nPx, nH+nSH; # little fine tune for fitting inside card border
  384.     display "";
  385. end;
  386.  
  387. button ckHold[5], frMain;
  388.     checkbox;
  389.     pixel_size nNW,nH;
  390.     display "";
  391. end;
  392.  
  393. button btOK, frMain;
  394.     display "OK";
  395.     pixel_size nNW,nH;
  396. end;
  397.  
  398. label lbWhat, frMain;
  399.     display "";
  400. end;
  401.  
  402. label lbDWhat, frMain;
  403.     display "";
  404. end;
  405.  
  406. button btDeal, frMain;
  407.     pixel_size nWW,75;
  408.     display "Deal";
  409.     position nL,nT+8*(nH+nSH);
  410.     hidden;
  411. end;
  412.  
  413. button btBet, frMain;
  414.     pixel_size nWW,75;
  415.     display "Bet";
  416.     position nL+1*(nWW+nSW),nT+8*(nH+nSH);
  417.     hidden;
  418. end;
  419.  
  420. button btPass, frMain;
  421.     pixel_size nWW,75;
  422.     display "Pass";
  423.     position nL+2*(nWW+nSW),nT+8*(nH+nSH);
  424.     hidden;
  425. end;
  426.  
  427. button btFold, frMain;
  428.     pixel_size nWW,75;
  429.     display "Fold";
  430.     position nL+3*(nWW+nSW),nT+8*(nH+nSH);
  431.     hidden;
  432. end;
  433.  
  434. label lbStatus, frMain;
  435.     display "";
  436. end;
  437.  
  438. label lbTotal, frMain;
  439.     font "largefont","",0;
  440.     display "";
  441. end;
  442.  
  443. # OBJECTS, MENU MAIN FORM
  444.  
  445. menu_top mtOptions, frMain;
  446.     display "Options";
  447. end;
  448.     
  449. menu_item miPrefs, mtOptions;
  450.     display "Preferences...";
  451. end;
  452.     
  453. menu_top mtHelp, frMain;
  454.     display "Help";
  455. end;
  456.     
  457. menu_item miHelp, mtHelp;
  458.     display "Help...";
  459. end;
  460.     
  461. menu_item miAbout, mtHelp;
  462.     display "About...";
  463. end;
  464.     
  465. # OBJECTS, BET INPUT FORM
  466.  
  467. frame frBet;
  468.     display "Enter Bet";
  469.     hidden;
  470. end;
  471.  
  472. label lbBRaise, frBet;
  473.     position nL,nT;
  474. end;
  475.  
  476. label lbBTotal, frBet;
  477.     position nL+3*(nW+nSW),nT;
  478. end;
  479.  
  480. label lbBHouseLimit, frBet;
  481.     position nL+3*(nW+nSW),nT+2*(nH+nSH);
  482. end;
  483.  
  484. label lbBDigit0, frBet;
  485.     position nL,nT+1*(nH+nSH);
  486. end;
  487.  
  488. label lbBDigit1, frBet;
  489.     position nL+1*(nW+nSW),nT+1*(nH+nSH);
  490. end;
  491.  
  492. selector slBDigit0, frBet;
  493.     list sBetSelect;
  494.     pixel_size nW,6*(nH+nSH);
  495.     position nL,nT+2*(nH+nSH);
  496. end;
  497.  
  498. selector slBDigit1, frBet;
  499.     list sBetSelect;
  500.     pixel_size nW,5*(nH+nSH);
  501.     position nL+1*(nW+nSW),nT+2*(nH+nSH);
  502. end;
  503.  
  504. button btBOK, frBet;
  505.     display "OK";
  506.     pixel_size nWW,nH;
  507.     position nL+2*(nWW+nSW),nT+8*(nH+nSH);
  508. end;
  509.  
  510. button btBReset, frBet;
  511.     display "Reset";
  512.     pixel_size nWW,nH;
  513.     position nL+1*(nWW+nSW),nT+8*(nH+nSH);
  514. end;
  515.  
  516. # OBJECTS, MESSAGE FORM
  517.  
  518. frame frMsgBox;
  519.     hidden;
  520. end;
  521.  
  522. text lbMMsgText, frMsgBox;
  523.     position nL,nT;
  524.     pixel_size 900,700;
  525.     no_input;
  526.     scrollbar top;
  527. end;
  528.  
  529. button btMOK, frMsgBox;
  530.     position 400,900;
  531.     pixel_size nWW,nH;
  532.     display "OK";
  533. end;
  534.  
  535. # OBJECTS, USER PREFERENCES
  536.  
  537. frame frPref;
  538.     display "Preferences";
  539.     hidden;
  540. end;
  541.  
  542. button ckPRecommendHold, frPref;
  543.     position nL,nT+0*(nH+nSH);
  544.     pixel_size 7*(nW+nSW),nH;
  545.     checkbox;
  546.     display "Show discard recommendations";
  547. end;
  548.  
  549. button ckPAtStart, frPref;
  550.     position nL,nT+1*(nH+nSH);
  551.     pixel_size 7*(nW+nSW),nH;
  552.     checkbox;
  553.     display "Shuffle at each game start";
  554. end;
  555.  
  556. text lbPUnits, frPref;
  557.     position nL,nT+2*(nH+nSH);
  558.     pixel_size 2*(nW+nSW),2*(nH+nSH);
  559.     display "Select units for display";
  560.     no_input;
  561. end;
  562.  
  563. text lbPHouseLimit, frPref;
  564.     position nL+3*(nW+nSW),nT+2*(nH+nSH);
  565.     pixel_size 2*(nW+nSW),2*(nH+nSH);
  566.     display "Select max bet in units";
  567.     no_input;
  568. end;
  569.  
  570. selector slPUnits, frPref;
  571.     position nL+0*(nW+nSW),nT+4*(nH+nSH);
  572.     pixel_size nW,4*(nH+nSH)-nSH;
  573.     list sUnits;
  574. end;
  575.  
  576. selector slPHouseLimit, frPref;
  577.     position nL+4*(nW+nSW),nT+4*(nH+nSH);
  578.     pixel_size nW,4*(nH+nSH)-nSH;
  579.     list sHouseLimit;
  580. end;
  581.  
  582. text lbPWhat, frPref;
  583.     position nL+1.5*(nW+nSW),nT+4*(nH+nSH);
  584.     pixel_size 2*(nW+nSW),4*(nH+nSH)-nSH;
  585.     no_input;
  586. end;
  587.  
  588. button btPOK, frPref;
  589.     position nL+2*(nWW+nSW),nT+8*(nH+nSH);
  590.     pixel_size nWW,nH;
  591.     display "OK";
  592. end;
  593.  
  594. button btPReset, frPref;
  595.     position nL+1*(nWW+nSW),nT+8*(nH+nSH);
  596.     pixel_size nWW,nH;
  597.     display "Reset";
  598. end;
  599.  
  600. # FUNCTIONS
  601.  
  602. # MISC MATH
  603.  
  604. #calculates base^exp, so don't need mathlib
  605. #
  606. function nfPower(numeric base, numeric exp) as numeric;
  607.     nfPower=1;
  608.     while exp>0;
  609.         nfPower=nfPower*base;
  610.         exp=exp-1;
  611.     end_while;
  612. end;
  613.  
  614. #calculates the log10 integer portion of n, so don't need mathlib
  615. #
  616. function nfIntLog(numeric n) as numeric;
  617.     variables;
  618.         numeric e;
  619.     end;
  620.     e=0;
  621.     while n>=10;
  622.         n=int(n/10);
  623.         e=e+1;
  624.     end_while;
  625.     nfIntLog=e;
  626. end;
  627.  
  628. # 5x9 GRID POSITIONS
  629.  
  630. # given 5 x 9 grid cell ref, col=0-4, row=0-8, returns x=0-999, y=0-999 in casl pixels
  631.  
  632. function nfXPos(numeric col) as numeric;
  633.     nfXPos=nL+col*(nW+nSW);
  634. end;
  635.  
  636. function nfYPos(numeric row) as numeric;
  637.     nfYPos=nT+row*(nH+nSH);
  638. end;
  639.  
  640. # GRAPHIC CARD FUNCTIONS
  641.  
  642. # given card ref, cardi=0-9, returns col=0-4, row=0-8
  643.  
  644. function nfColPos(numeric cardi) as numeric;
  645.     nfColPos=cardi%5;
  646. end;
  647.  
  648. function nfRowPos(numeric cardi) as numeric;
  649.     if cardi>4;
  650.         nfRowPos=4;
  651.     else;
  652.         nfRowPos=1;
  653.     end_if;
  654. end;
  655.  
  656. # given card string to display and cardi=0-4, draws box and display name,
  657. #  separate functions for user and dealer cards
  658.  
  659. function DrawCardUp(string name, numeric cardi);
  660.     # draw border
  661.     set frMain, pen, nfXPos(nfColPos(cardi)), nfYPos(nfRowPos(cardi));
  662.     draw frMain, rectangle, nW, 2*(nH+nSH)-nPx;
  663.     # display label
  664.     put lbCard[cardi], name;
  665.     show lbCard[cardi];
  666. end;
  667.  
  668. function DrawDCardUp(string name, numeric cardi);
  669.     # draw border
  670.     set frMain, pen, nfXPos(nfColPos(cardi+5)), nfYPos(nfRowPos(cardi+5));
  671.     draw frMain, rectangle, nW, 2*(nH+nSH)-nPx;
  672.     # display label
  673.     put lbDCard[cardi], name;
  674.     show lbDCard[cardi];
  675. end;
  676.  
  677. function DrawDCardDown(numeric cardi);
  678.     # display label
  679.     hide lbDCard[cardi];
  680.     # draw border
  681.     set frMain, pen, nfXPos(nfColPos(cardi+5)), nfYPos(nfRowPos(cardi+5));
  682.     fill frMain, rectangle, nW, 2*(nH+nSH)-nPx;
  683. end;
  684.  
  685. function ClearCard(numeric cardi);
  686.     # draw border
  687.     set frMain, pen, nfXPos(nfColPos(cardi)), nfYPos(nfRowPos(cardi));
  688.     clear frMain, rectangle, nW, 2*(nH+nSH)-nPx;
  689.     # display label
  690.     hide lbCard[cardi];
  691. end;
  692.  
  693. function ClearDCard(numeric cardi);
  694.     # draw border
  695.     set frMain, pen, nfXPos(nfColPos(cardi+5)), nfYPos(nfRowPos(cardi+5));
  696.     clear frMain, rectangle, nW, 2*(nH+nSH)-nPx;
  697.     # display label
  698.     hide lbDCard[cardi];
  699. end;
  700.  
  701. # CARD FUNCTIONS
  702.  
  703. function InitDeck;
  704.     variables;
  705.         numeric i;
  706.     end;
  707.     # fill deck
  708.     i=0;
  709.     while i<52;
  710.         nDeck[i]=i;
  711.         i=i+1;
  712.     end_while;
  713.     nNextCard=52; # force shuffle
  714. end;
  715.  
  716. #given cards to arrange, shufs times, randomly rearranges global deck array
  717. # by exchanging card elements of array.
  718. #
  719. function Shuffle (numeric cards, numeric shufs);
  720.     variables;
  721.         numeric temp;
  722.         numeric i;
  723.         numeric j;
  724.         numeric n;
  725.         numeric m;
  726.         string s;
  727.     end;
  728.     get lbDWhat, s;
  729.     put lbDWhat, "Shuffling...";
  730.     i=0;
  731.     while i<shufs;
  732.         j=0;
  733.         while j<cards;
  734.             n=randomn(52);
  735.             m=randomn(52);
  736.             temp=nDeck[n];
  737.             nDeck[n]=nDeck[m];
  738.             nDeck[m]=temp;
  739.             j=j+1;
  740.         end_while;
  741.         i=i+1;
  742.     end_while;
  743.     put lbDWhat, s;
  744. end;
  745.  
  746. # returns next card in deck 0-51, if last card, performs reshuffle first
  747. #
  748. function nfNextCard as numeric;
  749.     if nNextCard=nLastCard;
  750.         call Shuffle(nShufCards,nShufs);
  751.         nNextCard=0;
  752.     end_if;
  753.     nfNextCard=nDeck[nNextCard];
  754.     nNextCard=nNextCard+1;
  755. end;
  756.  
  757. #given 0-51, returns 2-14
  758. #
  759. function nfFace(numeric n) as numeric;
  760.     nfFace=(n%13)+2;
  761. end;
  762.  
  763. #given 0-51, returns 0-3
  764. #
  765. function nfSuit(numeric n) as numeric;
  766.     nfSuit=n%4;
  767. end;
  768.  
  769. #given 0-51, returns display string for face 2-14
  770. #
  771. function sfFace(numeric n) as string;
  772.     n=nfFace(n);
  773.     if n > 1 and n < 10; # number 2-9
  774.         sfFace=Char(48+n);
  775.     end_if;
  776.     if n = 10; # 10
  777.         sfFace=Char(49)+Char(48);
  778.     end_if;
  779.     if n = 11; # jack
  780.         sfFace=Char(74);
  781.     end_if;
  782.     if n = 12; # queen
  783.         sfFace=Char(81);
  784.     end_if;
  785.     if n = 13; # king
  786.         sfFace=Char(75);
  787.     end_if;
  788.     if n = 14; # high ace 
  789.         sfFace=Char(65);
  790.     end_if;
  791. end;
  792.  
  793. #given 0-51, returns display string for 0-3 suit
  794. #
  795. function sfSuit(numeric n) as string;
  796.     n=nfSuit(n);
  797.     # do suit string for each platform, windows font doesn't have 
  798.     # suit char
  799.     if platform = "windows";
  800.         if n=0;
  801.             sfSuit="d";
  802.         end_if;
  803.         if n=1;
  804.             sfSuit="c";
  805.         end_if;
  806.         if n=2;
  807.             sfSuit="h";
  808.         end_if;
  809.         if n=3;
  810.             sfSuit="s";
  811.         end_if;
  812.     else;
  813.         # pilot platform
  814.         sfSuit=Char(141+n);
  815.     end_if;
  816. end;
  817.  
  818. function sfCardName(numeric n) as string;
  819.     sfCardName=sfFace(n)+sfSuit(n);
  820. end;
  821.  
  822. # MISC ACCOUNTING FUNCTIONS
  823.  
  824. # takes any accounting variable, and multiplies by
  825. #  units for display purposes.  what is label.
  826. #
  827. function sfMoney(string what,numeric n) as string;
  828.     sfMoney=what+string(n*nUnits,"#");
  829. end;
  830.  
  831. # MISC MAIN FORM INITIALIZERS
  832.  
  833. # init data
  834. #
  835. function InitVariables;
  836.     nForm=0;
  837.     call InitDeck;
  838.     nTotal=nBank;
  839. end;
  840.  
  841. # move objects into position
  842. #
  843. function ArrangeVisObjects;
  844.     variables;
  845.         numeric i;
  846.     end;
  847.     i=0;
  848.     while i<5;
  849.         move lbCard[i],nfXPos(nfColPos(i))+nPx,nfYPos(nfRowPos(i))+nPx;
  850.         move ckHold[i],nfXPos(nfColPos(i)),nfYPos(0); 
  851.         move lbDCard[i],nfXPos(nfColPos(i+5))+nPx,nfYPos(nfRowPos(i+5))+nPx; 
  852.         hide ckHold[i];
  853.         i=i+1;
  854.     end_while;
  855.     move btOK, nfXPos(4.5),nfYPos(0); 
  856.     hide btOK;
  857.     move lbWhat, nfXPos(0),nfYPos(3);
  858.     move lbDWhat, nfXPos(0),nfYPos(6);
  859.     move lbStatus, nfXPos(0),nfYPos(7);
  860.     move lbTotal,  nfXPos(3),nfYPos(7);
  861.     show frMain; #force redraw
  862. end;
  863.  
  864. function Welcome;
  865.     variables;
  866.         sf[5]=3*13+12,0*13+11,1*13+10,2*13+9,3*13+8;
  867.         i=0;
  868.     end;
  869.     while i<5;
  870.         nHand[i]=sf[i];
  871.         call DrawCardUp(sfCardName(sf[i]),i);
  872.         i=i+1;
  873.     end_while;
  874.     put lbDWhat, "Let's play 5 card draw";
  875.     # display bank
  876.     put lbTotal, sfMoney("Total: ",nTotal);
  877. end;
  878.  
  879. function ClearDisplay;
  880.     variables;
  881.         numeric i;
  882.     end;
  883.     # clear display
  884.     i=0;
  885.     while i<5;
  886.         ClearCard(i);
  887.         ClearDCard(i);
  888.         i=i+1;
  889.     end_while;
  890.     put lbWhat, "";
  891.     put lbDWhat, "";
  892.     put lbStatus, "";
  893.     # clear system redraw list
  894.     # causes crash on both winrt and pilotrt, if do before first set/draw command
  895.     clear frMain, rectangle, 0, 0;
  896. end;
  897.  
  898. # after main form reshow, need to reput labels so show over redrawn graphics,
  899. #  only works on pilot
  900. #
  901. function RedrawHand;
  902.     variables;
  903.         numeric i;
  904.     end;
  905.     i=0;
  906.     while i<5;
  907.         #DrawCardUp(sfCardName(nHand[i]),i); # doesn't help on winrt
  908.         put lbCard[i], sfCardName(nHand[i]);
  909.         i=i+1;
  910.     end_while;
  911. end;
  912.  
  913. # MISC RANK
  914.  
  915. #decode nRank, use for test display, when not sure sRank is right
  916. #
  917. function sDecodeRank(numeric n) as string;
  918.     variables;
  919.         numeric m;
  920.         numeric i;
  921.         string s;
  922.     end;
  923.     i=5;
  924.     s="";
  925.     while i>-1;
  926.         m=int(n/nfPower(16,i));
  927.         s=s+" "+string(m,"#");
  928.         n=n-(m*nfPower(16,i));
  929.         i=i-1;
  930.     end_while;
  931.     sDecodeRank=s;
  932. end;
  933.  
  934. # RANK POKER HAND
  935.  
  936. # before rank detectors are used, hands are always first sorted 
  937. #  to ease search for matches,
  938. #
  939. # given bysuit=0 sorts by face, =1 sorts by suit,
  940. #  sorts hand[] array so highest is first element, 
  941. #  next highest is second, etc
  942. # face order: high ace, king, ... two
  943. # suit order: spade, heart, club, diamond
  944. #
  945. function SortHand(numeric hand[], numeric bysuit);
  946.     # scan all 5 cards, keep track of highest card, put
  947.     #  in first slot
  948.     # scan last 4 cards, keep track of highest card,
  949.     #  put in 2nd slot
  950.     # scan last 3 cards, keep track of highest card,...
  951.     variables;
  952.         numeric maxi; # slot with highest card
  953.         numeric temp; # temp card
  954.         numeric i;
  955.         numeric j;
  956.     end;
  957.     i=0;
  958.     while i<4; # don't need to do last card
  959.         maxi=i;
  960.         j=i+1;
  961.         while j<5;
  962.             if bysuit;
  963.                 if nfSuit(hand[j])>nfSuit(hand[maxi]);
  964.                     maxi=j;
  965.                 end_if;
  966.             else;
  967.                 if nfFace(hand[j])>nfFace(hand[maxi]);
  968.                     maxi=j;
  969.                 end_if;
  970.             end_if;
  971.             j=j+1;
  972.         end_while;
  973.         temp=hand[i];
  974.         hand[i]=hand[maxi];
  975.         hand[maxi]=temp;
  976.         i=i+1;
  977.     end_while;
  978. end;
  979.  
  980. # next 3 functions are low level comparators for
  981. #  determining hand rank
  982. #
  983. # given hand array and i element, looks at next neighboring i+1 card
  984. #  for match, returns true, or false
  985.  
  986. # use for like kinds
  987. #
  988. function bfEqualFace(numeric hand[],numeric i) as numeric;
  989.     bfEqualFace=nfFace(hand[i])=nfFace(hand[i+1]);
  990. end;
  991.  
  992. # use for flushes
  993. #
  994. function bfEqualSuit(numeric hand[],numeric i) as numeric;
  995.     bfEqualSuit=nfSuit(hand[i])=nfSuit(hand[i+1]);
  996. end;
  997.  
  998. # use for straights
  999. #
  1000. function bfNextFace(numeric hand[],numeric i) as numeric;
  1001.     bfNextFace=nfFace(hand[i])=nfFace(hand[i+1])+1;
  1002. end;
  1003.  
  1004. # next functions are detectors for each type of hand, return t/f
  1005. # side effects, if returns true:
  1006. #  hand is resorted by face,
  1007. #  nrank and srank are assigned the rank value
  1008. #  bhold is assigned t/f discard recommendations
  1009. #  nrank, srank, bhold are always completely reassigned, there is never 
  1010. #  remnant information remaining (no intialization needed)
  1011. # side effects, if returns false:
  1012. #  hand may be resorted by face or suit,
  1013. #  contents of all other inputs not specified
  1014.  
  1015. # use for detecting flush, d0=5
  1016. #
  1017. function bfFlush(numeric hand[], numeric nrank[], string srank[], numeric bhold[]) as numeric;
  1018.     variables;
  1019.         numeric f;
  1020.         numeric i;
  1021.     end;
  1022.     SortHand(hand,1);
  1023.     f=false();
  1024.     if bfEqualSuit(hand,0);
  1025.         # pair detected
  1026.         if bfEqualSuit(hand,1);
  1027.             # triple detected
  1028.             if bfEqualSuit(hand,2);
  1029.                 # quad detected
  1030.                 if bfEqualSuit(hand,3);
  1031.                     # quin detected
  1032.                     f=true();
  1033.                     nrank[0]=5*nfPower(16,5);
  1034.                     srank[0]="Flush";
  1035.                     SortHand(hand,0);
  1036.                     i=0;
  1037.                     while i<5;
  1038.                         nrank[0]=nrank[0]+nfFace(hand[i])*nfPower(16,4-i);
  1039.                         srank[0]=srank[0]+", "+sfFace(hand[i]);
  1040.                         bhold[i]=true();
  1041.                         i=i+1;
  1042.                     end_while;
  1043.                     srank[0]=srank[0]+" high";
  1044.                 end_if;
  1045.             end_if;
  1046.         end_if;
  1047.     end_if;
  1048.     bfFlush=f;
  1049. end;
  1050.  
  1051. # use for detecting staight, d0=4
  1052. #
  1053. function bfStraight(numeric hand[], numeric nrank[], string srank[], numeric bhold[]) as numeric;
  1054.     variables;
  1055.         numeric f;
  1056.         numeric i;
  1057.     end;
  1058.     SortHand(hand,0);
  1059.     f=false();
  1060.     if bfNextFace(hand,0);
  1061.         # pair detected
  1062.         if bfNextFace(hand,1);
  1063.             # triple detected
  1064.             if bfNextFace(hand,2);
  1065.                 # quad detected
  1066.                 if bfNextFace(hand,3);
  1067.                     # quin detected
  1068.                     f=true();
  1069.                     nrank[0]=4*nfPower(16,5)+nfFace(hand[0])*nfPower(16,4);
  1070.                     srank[0]="Straight, "+sfFace(hand[0])+" high";
  1071.                     i=0;
  1072.                     while i<5;
  1073.                         bhold[i]=true();
  1074.                         i=i+1;
  1075.                     end_while;
  1076.                 end_if;
  1077.             end_if;
  1078.         end_if;
  1079.     end_if;
  1080.     bfStraight=f;
  1081. end;
  1082.  
  1083. # detects straight flush, d0=8
  1084. #
  1085. function bfStraightFlush(numeric hand[], numeric nrank[], string srank[], numeric bhold[]) as numeric;
  1086.     variables;
  1087.         numeric f;
  1088.         numeric i;
  1089.     end;
  1090.     f=0;
  1091.     if bfFlush(hand, nrank, srank, bhold) and bfStraight(hand, nrank, srank, bhold);
  1092.         f=true();
  1093.         nrank[0]=8*nfPower(16,5)+nfFace(hand[0])*nfPower(16,4);
  1094.         srank[0]="Straight Flush, "+sfFace(hand[0])+" high";
  1095.         i=0;
  1096.         while i<5;
  1097.             bhold[i]=true();
  1098.             i=i+1;
  1099.         end_while;
  1100.     end_if;
  1101.     bfStraightFlush=f;
  1102. end;
  1103.  
  1104. # four of a kind, d0=7
  1105. #
  1106. function bfFourKind(numeric hand[], numeric nrank[], string srank[], numeric bhold[]) as numeric;
  1107.     variables;
  1108.         numeric f;
  1109.         numeric i;
  1110.         numeric j;
  1111.     end;
  1112.     SortHand(hand,0);
  1113.     f=false();
  1114.     i=0;
  1115.     while i<2; # no point checking last 3 cards
  1116.         if bfEqualFace(hand,i);
  1117.             # pair detected
  1118.             if bfEqualFace(hand,i+1);
  1119.                 # triple detected
  1120.                 if bfEqualFace(hand,i+2);
  1121.                     # quad detected
  1122.                     f=true();
  1123.                     nrank[0]=7*nfPower(16,5)+nfFace(hand[i])*nfPower(16,4);
  1124.                     srank[0]="Four "+sfFace(hand[i])+"'s";
  1125.                     j=0;
  1126.                     while j<5;
  1127.                         if j=i or j=i+1 or j=i+2 or j=i+3;
  1128.                             bhold[i]=true();
  1129.                         else;
  1130.                             nrank[0]=nrank[0]+nfFace(hand[j])*nfPower(16,3);
  1131.                             srank[0]=srank[0]+", "+sfFace(hand[j]);
  1132.                             if nfFace(hand[j])>=11;
  1133.                                 bhold[i]=true();
  1134.                             else;
  1135.                                 bhold[i]=false();
  1136.                             end_if;
  1137.                         end_if;
  1138.                         j=j+1;
  1139.                     end_while;
  1140.                     srank[0]=srank[0]+" high";
  1141.                     i=5; #force loop exit
  1142.                 end_if;
  1143.             end_if;
  1144.         end_if;
  1145.         i=i+1;
  1146.     end_while;
  1147.     bfFourKind=f;
  1148. end;
  1149.  
  1150. # full house, d0=6
  1151. #
  1152. function bfFullHouse(numeric hand[], numeric nrank[], string srank[], numeric bhold[]) as numeric;
  1153.     variables;
  1154.         numeric f;
  1155.         numeric i;
  1156.         numeric j;
  1157.         numeric k;
  1158.     end;
  1159.     SortHand(hand,0);
  1160.     f=false();
  1161.     i=0;
  1162.     # check for triple
  1163.     while i<3; # no point checking last 2 cards
  1164.         if bfEqualFace(hand,i);
  1165.             # pair detected
  1166.             if bfEqualFace(hand,i+1);
  1167.                 # triple starts at i, check for 2nd pair
  1168.                 j=0;
  1169.                 while j<4;
  1170.                     if j=i or j=i+1 or j=i+2 or j=i-1; # i-1 prevents false detect when 4kind
  1171.                     else;
  1172.                         # check for 2nd pair
  1173.                         if bfEqualFace(hand,j);
  1174.                             # detected 2 pair at j, 1st triple starts at i,
  1175.                             f=true();
  1176.                             nrank[0]=6*nfPower(16,5)+nfFace(hand[i])*nfPower(16,4)+nfFace(hand[j])*nfPower(16,3);
  1177.                             srank[0]="Full House, "+sfFace(hand[i])+"'s over "+sfFace(hand[j])+"'s";
  1178.                             k=0;
  1179.                             while k<5;
  1180.                                 bhold[k]=true();
  1181.                                 k=k+1;
  1182.                             end_while;
  1183.                             # no odd card
  1184.                             j=5; # force exit
  1185.                             i=5; #
  1186.                         end_if;
  1187.                     end_if;
  1188.                     j=j+1;
  1189.                 end_while;
  1190.             end_if;
  1191.         end_if;
  1192.         i=i+1;
  1193.     end_while;
  1194.     bfFullHouse=f;
  1195. end;
  1196.  
  1197. # three of a kind, d0=3
  1198. #
  1199. function bfThreeKind(numeric hand[], numeric nrank[], string srank[], numeric bhold[]) as numeric;
  1200.     variables;
  1201.         numeric f;
  1202.         numeric i;
  1203.         numeric j;
  1204.         numeric n;
  1205.     end;
  1206.     SortHand(hand,0);
  1207.     f=false();
  1208.     i=0;
  1209.     while i<3; # no point checking last 2 cards
  1210.         if bfEqualFace(hand,i);
  1211.             # pair detected
  1212.             if bfEqualFace(hand,i+1);
  1213.                 # triple detected
  1214.                 f=true();
  1215.                 nrank[0]=3*nfPower(16,5)+nfFace(hand[i])*nfPower(16,4);
  1216.                 srank[0]="Three "+sfFace(hand[i])+"'s";
  1217.                 j=0;
  1218.                 n=3;
  1219.                 while j<5;
  1220.                     if j=i or j=i+1 or j=i+2;
  1221.                         bhold[j]=true();
  1222.                     else;
  1223.                         nrank[0]=nrank[0]+nfFace(hand[j])*nfPower(16,n);
  1224.                         srank[0]=srank[0]+", "+sfFace(hand[j]);
  1225.                         bhold[j]=false();
  1226.                         n=n-1;
  1227.                     end_if;
  1228.                     j=j+1;
  1229.                 end_while;
  1230.                 srank[0]=srank[0]+" high";
  1231.                 i=5; #force loop exit
  1232.             end_if;
  1233.         end_if;
  1234.         i=i+1;
  1235.     end_while;
  1236.     bfThreeKind=f;
  1237. end;
  1238.  
  1239. # two pair, d0=2
  1240. #
  1241. function bfTwoPair(numeric hand[], numeric nrank[], string srank[], numeric bhold[]) as numeric;
  1242.     variables;
  1243.         numeric f;
  1244.         numeric i;
  1245.         numeric j;
  1246.         numeric n;
  1247.     end;
  1248.     SortHand(hand,0);
  1249.     f=false();
  1250.     i=0;
  1251.     while i<4; # no point checking last card
  1252.         if bfEqualFace(hand,i);
  1253.             # pair detected
  1254.             j=0;
  1255.             while j<4;
  1256.                 if j=i or j=i+1 or j=i-1; # i-1 prevents false detect when 3kind
  1257.                 else;
  1258.                     # check for another pair
  1259.                     if bfEqualFace(hand,j);
  1260.                         # detected 2 pair, 1st pair starts at i,
  1261.                         #  2nd pair starts at j
  1262.                         f=true();
  1263.                         nrank[0]=2*nfPower(16,5)+nfFace(hand[i])*nfPower(16,4)+nfFace(hand[j])*nfPower(16,3);
  1264.                         srank[0]="Two Pair, "+sfFace(hand[i])+"'s and "+sfFace(hand[j])+"'s";
  1265.                         # find odd card
  1266.                         n=0;
  1267.                         while n<5;
  1268.                             if n=i or n=i+1 or n=j or n=j+1;
  1269.                                 bhold[n]=true();
  1270.                             else;
  1271.                                 nrank[0]=nrank[0]+nfFace(hand[n])*nfPower(16,2);
  1272.                                 srank[0]=srank[0]+", "+sfFace(hand[n])+" high";
  1273.                                 bhold[n]=false();
  1274.                             end_if;
  1275.                             n=n+1;
  1276.                         end_while;
  1277.                         j=5; # force exit
  1278.                         i=5; #
  1279.                     end_if;
  1280.                 end_if;
  1281.                 j=j+1;
  1282.             end_while;
  1283.         end_if;
  1284.         i=i+1;
  1285.     end_while;
  1286.     bfTwoPair=f;
  1287. end;
  1288.  
  1289. # one pair, d0=1
  1290. #
  1291. function bfOnePair(numeric hand[], numeric nrank[], string srank[], numeric bhold[]) as numeric;
  1292.     variables;
  1293.         numeric f;
  1294.         numeric i;
  1295.         numeric j;
  1296.         numeric n;
  1297.     end;
  1298.     SortHand(hand,0);
  1299.     f=false();
  1300.     i=0;
  1301.     while i<4; # no point checking last card
  1302.         if bfEqualFace(hand,i);
  1303.             # pair detected
  1304.             f=true();
  1305.             nrank[0]=1*nfPower(16,5)+nfFace(hand[i])*nfPower(16,4);
  1306.             srank[0]="Two "+sfFace(hand[i])+"'s";
  1307.             j=0;
  1308.             n=3;
  1309.             while j<5;
  1310.                 if j=i or j=i+1;
  1311.                     bhold[j]=true();
  1312.                 else;
  1313.                     nrank[0]=nrank[0]+nfFace(hand[j])*nfPower(16,n);
  1314.                     srank[0]=srank[0]+", "+sfFace(hand[j]);
  1315.                     n=n-1;
  1316.                     bhold[j]=false();
  1317.                 end_if;
  1318.                 j=j+1;
  1319.             end_while;
  1320.             srank[0]=srank[0]+" high";
  1321.             i=5; #force loop exit
  1322.         end_if;
  1323.         i=i+1;
  1324.     end_while;
  1325.     bfOnePair=f;
  1326. end;
  1327.  
  1328. # high card, d0=0
  1329. #
  1330. function NoHand(numeric hand[], numeric nrank[], string srank[], numeric bhold[]);
  1331.     variables;
  1332.         numeric i;
  1333.     end;
  1334.     SortHand(hand,0);
  1335.     nrank[0]=0;
  1336.     srank[0]="High Card";
  1337.     i=0;
  1338.     while i<5;
  1339.         nrank[0]=nrank[0]+nfFace(hand[i])*nfPower(16,4-i);
  1340.         srank[0]=srank[0]+", "+sfFace(hand[i]);
  1341.         i=i+1;
  1342.     end_while;
  1343.     # keep high card
  1344.     bhold[0]=true();
  1345.     if hand[0]=14;
  1346.         # can discard 4 or 3 cards
  1347.         if hand[1]>=11;
  1348.             # keep jack or better too
  1349.             bhold[1]=true();
  1350.         else;
  1351.             # discard 4 cards
  1352.             bhold[1]=false();
  1353.         end_if;
  1354.     else;
  1355.         # can only discard 3 cards
  1356.         bhold[1]=true();
  1357.     end_if;
  1358.     # discard last 3 cards
  1359.     bhold[2]=false();
  1360.     bhold[3]=false();
  1361.     bhold[4]=false();
  1362. end;
  1363.  
  1364. # Rank is main calling function
  1365.  
  1366. #first go, not very efficient, for example the hand must be looked at about
  1367. # thousand times before determining what rank hand is.  fully tested and is
  1368. # accurate, so will use for now.
  1369. #sfRank benchmarking data for comparision later when trying to optimize:
  1370. # pair   3070 ms
  1371. # "      3080
  1372. # 2 pair 2670
  1373. # "      2670
  1374. # hcard, 3230    high card takes longest since is longest logic path
  1375. # 2 pair 2610
  1376. # hcard  3380
  1377. # pair   3050
  1378. # "      3100
  1379. # "      3130
  1380. # triple 2390
  1381.  
  1382. # the main ranker, call with user or dealer arrays, (by reference so 
  1383. #  assigned values persist after call)
  1384. # side effects:
  1385. #  hand is sorted by face,
  1386. #  nrank and srank are assigned the rank value
  1387. #  bhold is assigned t/f keep recommendations
  1388. #  nrank, srank, bhold are always completely reassigned, there is never 
  1389. #   remnant information remaining (no intialization needed)
  1390. #  while processing displays wait message to lbDWhat
  1391. #
  1392. function Rank(numeric hand[], numeric nrank[], string srank[], numeric bhold[]);
  1393.     variables;
  1394.         string s;
  1395.     end;
  1396.     get lbDWhat, s;
  1397.     put lbDWhat, "Ranking hand..."; # feedback for user, so knows pilot busy
  1398.     if bfStraightFlush(hand, nrank, srank, bhold);
  1399.     else;
  1400.         if bfFourKind(hand, nrank, srank, bhold);
  1401.         else;
  1402.             if bfFullHouse(hand, nrank, srank, bhold);
  1403.             else;
  1404.                 if bfFlush(hand, nrank, srank, bhold);
  1405.                 else;
  1406.                     if bfStraight(hand, nrank, srank, bhold);
  1407.                     else;
  1408.                         if bfThreeKind(hand, nrank, srank, bhold);
  1409.                         else;
  1410.                             if bfTwoPair(hand, nrank, srank, bhold);
  1411.                             else;
  1412.                                 if bfOnePair(hand, nrank, srank, bhold);
  1413.                                 else;
  1414.                                     call NoHand(hand, nrank, srank, bhold);
  1415.                                 end_if;
  1416.                             end_if;
  1417.                         end_if;
  1418.                     end_if;
  1419.                 end_if;
  1420.             end_if;
  1421.         end_if;
  1422.     end_if;
  1423.     put lbDWhat, s;
  1424. end;
  1425.  
  1426. # MISC POKER HAND RECOGNIZERS
  1427.  
  1428. function bfHoldAce(numeric hand[],numeric bhold[]) as numeric;
  1429.     variables;
  1430.         numeric i;
  1431.         numeric f;
  1432.     end;
  1433.     f=0;
  1434.     i=0;
  1435.     while i<5;
  1436.         if nfFace(hand[i])=14 and bhold[i];
  1437.             f=true();
  1438.             i=5;
  1439.         end_if;
  1440.         i=i+1;
  1441.     end_while;
  1442.     bfHoldAce=f;
  1443. end;
  1444.  
  1445. # PLAY POKER
  1446.  
  1447. # user and dealer ante up
  1448. #
  1449. function AnteUp;
  1450.     # clear display
  1451.     call ClearDisplay;
  1452.     # ante up
  1453.     nBet=nAnte;
  1454.     put lbStatus, sfMoney("Bet: ",nBet);
  1455.     # clear fold flags
  1456.     bFold=false();
  1457.     bDFold=false();
  1458. end;
  1459.  
  1460. # given prompt for user, makes user bet state active
  1461. #  global flags for bet round, and dealer raise
  1462. #
  1463. function UserBetPrep(string s);
  1464.     put lbDWhat, s;
  1465.     put lbTotal, sfMoney("Total: ",nTotal);
  1466.     put lbStatus, sfMoney("Bet: ",nBet);
  1467.     if bDRaise;
  1468.         put btPass, "See";
  1469.     else;
  1470.         put btPass, "Pass";
  1471.     end_if;
  1472.     show btBet;
  1473.     show btPass;
  1474.     show btFold;
  1475. end;
  1476.  
  1477. # deal user and dealer hands
  1478. #
  1479. function Deal;
  1480.     variables;
  1481.         numeric i;
  1482.     end;
  1483.     if bAtStart;
  1484.         nNextCard=nLastCard;
  1485.     end_if;
  1486.     # fill hand arrays, and display user hand, back of dealer hand
  1487.     i=0;
  1488.     while i<5;
  1489.         nHand[i]=nfNextCard;
  1490.         DrawCardUp(sfCardName(nHand[i]), i);
  1491.         #nHand[i]=nTestHand[i]; # put in for forcing hand
  1492.         nDHand[i]=nfNextCard;
  1493.         DrawDCardDown(i); #put lbDCard[i], sfCardBack();
  1494.         i=i+1;
  1495.     end_while;
  1496.     # determine user rank, time consuming on pilot, approx 3s
  1497.     #i=timevalue(); # @put in for benchmarking
  1498.     call Rank(nHand, nRank, sRank, bHold); 
  1499.     #i=timevalue()-i; # @
  1500.     # display sorted user hand
  1501.     i=0;
  1502.     while i<5;
  1503.         ClearCard(i);
  1504.         DrawCardUp(sfCardName(nHand[i]), i);
  1505.         i=i+1;
  1506.     end_while;
  1507.     # display rank
  1508.     put lbWhat, sRank[0]; # @comment out
  1509.     #put lbWhat, sRank[0]+string(i,"######.#"); # @
  1510.     # determine dealer rank, needed before DDealerBet1 
  1511.     put lbDWhat, "";
  1512.     Rank(nDHand,nDRank,sDRank, bDHold);
  1513.     # get ready for user bet round1
  1514.     bRound2=false();
  1515.     bDRaise=false();
  1516.     nTempBet=0;
  1517.     call UserBetPrep("Make your bet");
  1518. end;
  1519.  
  1520. # game over, determine winner
  1521. #
  1522. function ReconcileBet;
  1523.     variables;
  1524.         numeric i;
  1525.     end;
  1526.     put lbDWhat, "";
  1527.     # determine winner
  1528.     if bFold;
  1529.         # user folded
  1530.         nTotal=nTotal-nBet;
  1531.         put lbStatus, sfMoney("Fold, you lose ",nBet);
  1532.     else;
  1533.         if bDFold;
  1534.             # dealer folded
  1535.             nTotal=nTotal+nBet;
  1536.             put lbStatus, sfMoney("Fold, you win ",nBet)+"!";
  1537.         else;
  1538.             # display dealer hand
  1539.             i=0;
  1540.             while i<5;
  1541.                 ClearDCard(i);
  1542.                 DrawDCardUp(sfCardName(nDHand[i]),i);
  1543.                 i=i+1;
  1544.             end_while;
  1545.             # display dealer rank
  1546.             put lbDWhat, sDRank[0];
  1547.             # duke it out
  1548.             if nRank[0]=nDRank[0];
  1549.                 put lbStatus, "Tie, can't rank suit";
  1550.             else;
  1551.                 if nRank[0]>nDRank[0];
  1552.                     nTotal=nTotal+nBet;
  1553.                     put lbStatus, sfMoney("You win ",nBet)+"!";
  1554.                 else;
  1555.                     nTotal=nTotal-nBet;
  1556.                     put lbStatus, sfMoney("Sorry, you lose ",nBet);
  1557.                 end_if;
  1558.             end_if;
  1559.         end_if;
  1560.     end_if;
  1561.     # display bank
  1562.     put lbTotal, sfMoney("Total: ",nTotal);
  1563.     # user starts deal when ready
  1564.     bAllowPrefs=true();
  1565.     show btDeal;
  1566. end;
  1567.  
  1568. function UserDrawSelectPrep;
  1569.     variables;
  1570.         numeric i;
  1571.     end;
  1572.     # prepare for user draw select
  1573.     i=0;
  1574.     while i<5;
  1575.         if not bRecommendHold;
  1576.             bHold[i]=false();
  1577.         end_if;
  1578.         put ckHold[i], bHold[i];
  1579.         show ckHold[i];
  1580.         i=i+1;
  1581.     end_while;
  1582.     put lbDWhat, "Dealer accepts bet. Check to hold";
  1583.     put lbTotal, sfMoney("Total: ",nTotal);
  1584.     put lbStatus, sfMoney("Bet: ",nBet);
  1585.     show btOK;
  1586. end;
  1587.  
  1588. # deal cards to replace discards to both user and dealer
  1589. #
  1590. function DealDraw;
  1591.     variables;
  1592.         numeric i;
  1593.         numeric n;
  1594.     end;
  1595.     # clear card, then deal card if user check flag set
  1596.     i=0;
  1597.     while i<5;
  1598.         if not bHold[i];
  1599.             ClearCard(i);
  1600.         end_if;
  1601.         i=i+1;
  1602.     end_while;
  1603.     i=0;
  1604.     while i<5;
  1605.         if not bHold[i];
  1606.             nHand[i]=nfNextCard;
  1607.             DrawCardUp(sfCardName(nHand[i]),i);
  1608.         end_if;
  1609.         i=i+1;
  1610.     end_while;
  1611.     # determine user rank
  1612.     put lbDWhat, "";
  1613.     call Rank(nHand, nRank, sRank, bHold); 
  1614.     # display sorted user hand
  1615.     i=0;
  1616.     while i<5;
  1617.             ClearCard(i);
  1618.             DrawCardUp(sfCardName(nHand[i]),i);
  1619.         i=i+1;
  1620.     end_while;
  1621.     # display user rank
  1622.     put lbWhat, sRank[0];
  1623.     # deal card if dealer flag set, count how many
  1624.     n=0;
  1625.     i=0;
  1626.     while i<5;
  1627.         if not bDHold[i];
  1628.             # if show, can give away pair to user, etc
  1629.             nDHand[i]=nfNextCard;
  1630.             n=n+1;
  1631.         end_if;
  1632.         i=i+1;
  1633.     end_while;
  1634.     # determine dealer rank, needed before DDealerBet2
  1635.     put lbDWhat, "";
  1636.     Rank(nDHand,nDRank,sDRank, bDHold);
  1637.     # set round 2 bet flag
  1638.     bRound2=true();
  1639.     bDRaise=false();
  1640.     nTempBet=0;
  1641.     call UserBetPrep("Dealer drew "+string(n,"#")+" cards. Make your bet");
  1642. end;
  1643.  
  1644. # DEALER PERSONALITY FUNCTIONS
  1645.  
  1646. function DInitMaxBets(numeric max);
  1647.     #  max bets
  1648.     nMaxGoodBet=max; # must not exceed house limit
  1649.     nMaxOKBet=int(nMaxGoodBet/2);
  1650.     nMaxBadBet=int(nMaxOKBet/2);
  1651. end;
  1652.  
  1653. # given hand rank array, computes rank number
  1654. #
  1655. function nfDMakeRank(numeric rank[]) as numeric;
  1656.     variables;
  1657.         numeric i;
  1658.     end;
  1659.     nfDMakeRank=0;
  1660.     i=0;
  1661.     while i<6;
  1662.         nfDMakeRank=nfDMakeRank+rank[5-i]*nfPower(16,i);
  1663.         i=i+1;
  1664.     end_while;
  1665. end;
  1666.  
  1667. function DDealerBet1;
  1668.     variables;
  1669.         numeric maxbet;
  1670.         numeric braise;
  1671.     end;
  1672.     # dealer determines action based on its hand and user bet
  1673.     braise=false();
  1674.     if nDRank[0]>=nfDMakeRank(nMinGoodRank1);
  1675.         # 1st round good hand
  1676.         braise=true();
  1677.         maxbet=int(nMaxGoodBet);
  1678.     else;
  1679.         if nDRank[0]>=nfDMakeRank(nMinOKRank1);
  1680.             # 1st round ok hand
  1681.             maxbet=nMaxOKBet;
  1682.         else;
  1683.             # 1st round bad hand
  1684.             maxbet=nMaxBadBet;
  1685.         end_if;
  1686.     end_if;
  1687.     if braise;
  1688.         # accept bet and...
  1689.         nBet=nBet+nTempBet;
  1690.         if nBet<maxbet;
  1691.             # suggest raise
  1692.             bDRaise=true();
  1693.             # round to nearest aAnte
  1694.             nTempBet=int((maxbet-nBet)/2/nAnte)*nAnte; 
  1695.             call UserBetPrep(sfMoney("Dealer accepts and raises ",
  1696.              nTempBet));
  1697.         else;
  1698.             # prepare for user draw select
  1699.             call UserDrawSelectPrep;
  1700.         end_if;
  1701.     else;
  1702.         if nBet+nTempBet<=maxbet;
  1703.             # accept bet
  1704.             nBet=nBet+nTempBet;
  1705.             call UserDrawSelectPrep;
  1706.         else;
  1707.             # fold
  1708.             bDFold=true();
  1709.             call ReconcileBet;
  1710.         end_if;
  1711.     end_if;
  1712. end;
  1713.  
  1714. function DDealerBet2;
  1715.     variables;
  1716.         numeric maxbet;
  1717.         numeric braise;
  1718.     end;
  1719.     # dealer determines action based on its hand and user bet
  1720.     braise=false();
  1721.     if nDRank[0]>=nfDMakeRank(nMinGoodRank2) or nPercentBluff>randomn(100);
  1722.         # 2nd round good hand or bluff
  1723.         braise=true();
  1724.         maxbet=2*nMaxGoodBet;
  1725.     else;
  1726.         if nDRank[0]>=nfDMakeRank(nMinOKRank2);
  1727.             # 2nd round ok hand
  1728.             maxbet=2*nMaxOKBet;
  1729.         else;
  1730.             # 2nd round bad hand
  1731.             maxbet=2*nMaxBadBet;
  1732.         end_if;
  1733.     end_if;
  1734.     if braise;
  1735.         # accept bet and...
  1736.         nBet=nBet+nTempBet;
  1737.         if nBet<maxbet;
  1738.             # suggest raise
  1739.             bDRaise=true();
  1740.             nTempBet=int((maxbet-nBet)/2/nAnte)*nAnte;
  1741.             call UserBetPrep(sfMoney("Dealer accepts and raises ",
  1742.              nTempBet));
  1743.         else;
  1744.             put lbDWhat, "Dealer accepts bet";
  1745.             put lbTotal, sfMoney("Total: ",nTotal);
  1746.             put lbStatus, sfMoney("Bet: ",nBet);
  1747.             call ReconcileBet;
  1748.         end_if;
  1749.     else;
  1750.         if nBet+nTempBet<=maxbet;
  1751.             # accept bet
  1752.             nBet=nBet+nTempBet;
  1753.             put lbDWhat, "Dealer accepts bet";
  1754.             put lbTotal, sfMoney("Total: ",nTotal);
  1755.             put lbStatus, sfMoney("Bet: ",nBet);
  1756.             call ReconcileBet;
  1757.         else;
  1758.             # fold
  1759.             bDFold=true();
  1760.             call ReconcileBet;
  1761.         end_if;
  1762.     end_if;
  1763. end;
  1764.  
  1765. # determine what cards dealer would like to discard
  1766. #
  1767. function DealerDrawSelect;
  1768.     # draw cards already known from rank during Deal function
  1769.     call DealDraw;
  1770. end;
  1771.  
  1772. # FUNCTIONS, BET INPUT FORM
  1773.  
  1774. function BDisplayBetLabels();
  1775.     # display bet selectors labels with their increment * nUnits
  1776.     put lbBDigit0, sfMoney("",nfPower(10,nBExp0))+"'s";
  1777.     put lbBDigit1, sfMoney("",nfPower(10,nBExp1))+"'s";
  1778. end;
  1779.  
  1780. function BDisplayHouseLimit(numeric br2);
  1781.     variables;
  1782.         numeric i;
  1783.     end;
  1784.     i=nHouseLimit;
  1785.     if br2;
  1786.         i=2*i;
  1787.     end_if;
  1788.     put lbBHouseLimit, sfMoney("Max Bet: ",i);
  1789. end;
  1790.  
  1791. # given br2=t/f for bet round2, sets up bet input form
  1792. #
  1793. function BInitBet(numeric br2);
  1794.     # determine best bet increment, based on nHouseLimit
  1795.     #  power of 10 magnitude, nHouseLimit must be >= 10
  1796.     #  or decimal increment won't display
  1797.     nBExp1=nfIntLog(nHouseLimit);
  1798.     nBExp0=nBExp1-1;
  1799.     # set max range based on nHouseLimit
  1800.     if nfPower(10,nBExp1)>nHouseLimit;
  1801.         # don't need
  1802.         put slBDigit1,-1;
  1803.     else;
  1804.         if 9*nfPower(10,nBExp1)>nHouseLimit;
  1805.             # clip range
  1806.             put slBDigit1,-int((nHouseLimit)/nfPower(10,nfIntLog(nHouseLimit))+0.5);
  1807.         else;
  1808.             # max range ok
  1809.             put slBDigit1,-10;
  1810.         end_if;
  1811.     end_if;
  1812.     if nfPower(10,nBExp0)>nHouseLimit;
  1813.         # don't need
  1814.         put slBDigit0,-1;
  1815.     else;
  1816.         if 9*nfPower(10,nBExp0)>nHouseLimit;
  1817.             # clip range
  1818.             put slBDigit0,-int((nHouseLimit)/nfPower(10,nfIntLog(nHouseLimit))+0.5);
  1819.         else;
  1820.             # max range ok
  1821.             put slBDigit0,-10;
  1822.         end_if;
  1823.     end_if;
  1824.     call BDisplayBetLabels;
  1825.     call BDisplayHouseLimit(br2);
  1826. end;
  1827.  
  1828. function BDisplayBet;
  1829.     variables;
  1830.         numeric d1;
  1831.         numeric d2;
  1832.     end;
  1833.     get slBDigit0, d1;
  1834.     get slBDigit1, d2;
  1835.     nTempBet=d2*nfPower(10,nBExp1)+d1*nfPower(10,nBExp0);
  1836.     put lbBRaise, sfMoney("New bet: ",nTempBet);
  1837.     put lbBTotal, sfMoney("Total bet: ",nTempBet+nBet);
  1838. end;
  1839.  
  1840. function BClearBet(numeric br2);
  1841.     # clear suggested bet
  1842.     nTempBet=0;
  1843.     # reset selectors to 0 default
  1844.     put slBDigit0,0;
  1845.     put slBDigit1,0;
  1846.     # display bet
  1847.     call BDisplayBet;
  1848.     call BDisplayHouseLimit(br2);
  1849.     # gets rid of double ghost highlighting
  1850.     hide slBDigit0;
  1851.     hide slBDigit1;
  1852.     show slBDigit0;
  1853.     show slBDigit1;
  1854. end;
  1855.  
  1856. # FUNCTIONS, PREFERENCES FORM
  1857.  
  1858. function PDisplayUnits;
  1859.     put slPUnits,nUnitsI;
  1860.     nUnits=value(sUnits[nUnitsI]);
  1861. end;
  1862.  
  1863. function PDisplayHouseLimit;
  1864.     put slPHouseLimit,nHouseLimitI;
  1865.     nHouseLimit=value(sHouseLimit[nHouseLimitI]);
  1866. end;
  1867.  
  1868. function PDisplayPrefStatus;
  1869.     put lbPWhat,sfMoney("Ante=",nAnte)+", "+sfMoney("Total=",nTotal)+
  1870.      ", "+sfMoney("Max Bet=",nHouseLimit);
  1871. end;
  1872.  
  1873. function PDefaultPrefs;
  1874.     # default show hold recommendations
  1875.     bRecommendHold=true();
  1876.     bAtStart=true();
  1877.     put ckPRecommendHold, bRecommendHold;
  1878.     put ckPAtStart, bAtStart;
  1879.     # default units and houselimit
  1880.     nUnitsI=3;
  1881.     call PDisplayUnits;
  1882.     nHouseLimitI=1;
  1883.     call PDisplayHouseLimit;
  1884.     call PDisplayPrefStatus;
  1885.     call BInitBet(false()); # edit prefs only at game start
  1886.     call DInitMaxBets(nHouseLimit);
  1887.     # gets rid of double ghost highlighting
  1888.     hide slPUnits;
  1889.     hide slPHouseLimit;
  1890.     show slPUnits;
  1891.     show slPHouseLimit;
  1892. end;
  1893.  
  1894. # GENERAL SHOW FORM FUNCTION
  1895.  
  1896. function ShowForm(numeric old, numeric new);
  1897.     if old<>new;
  1898.         nPriorPriorForm=nPriorForm;
  1899.         nPriorForm=old;
  1900.         nForm=new;
  1901.         if new=0; # main
  1902.             show frMain;
  1903.             if nPriorForm=2;
  1904.                 put lbTotal, sfMoney("Total: ",nTotal);
  1905.             end_if;
  1906.             # reput labels over redrawn graphics
  1907.             call RedrawHand;
  1908.         else;
  1909.             if new=1; # bet input
  1910.                 if nPriorForm=0;
  1911.                     call BClearBet(bRound2);
  1912.                 end_if;
  1913.                 show frBet;
  1914.             else;
  1915.                 if new=2; # pref form
  1916. #                    call PDisplayPref
  1917.                     show frPref;
  1918.                 else;
  1919.                     if new=3; # help
  1920.                         put frMsgBox, "Help";
  1921.                         show frMsgBox;
  1922.                         # after show, forces scrollbar show
  1923.                         put lbMMsgText, sMHelp;
  1924.                     else;
  1925.                         if new=4; # about
  1926.                             put frMsgBox, "About";
  1927.                             show frMsgBox;
  1928.                             # after show, forces scrollbar show
  1929.                             put lbMMsgText, sMAbout1+sMAbout2+
  1930.                              sMAbout3+sMAbout4;
  1931.                         else;
  1932.                         end_if;
  1933.                     end_if;
  1934.                 end_if;
  1935.             end_if;
  1936.         end_if;
  1937.     end_if;
  1938. end;
  1939.  
  1940. # USER (INVOKER) FUNCTIONS
  1941.  
  1942. function btDeal;
  1943.     hide btDeal;
  1944.     # can't change units or houselimit during hand play
  1945.     bAllowPrefs=false();
  1946.     call AnteUp;
  1947.     call Deal;
  1948. end;
  1949.  
  1950. function btBet;
  1951.     hide btBet;
  1952.     hide btPass;
  1953.     hide btFold;
  1954.     # accept any raise
  1955.     nBet=nBet+nTempBet;
  1956.     # get bet
  1957.     hide frMain;
  1958.     call ShowForm(0,1);
  1959. end;
  1960.  
  1961. function btPass;
  1962.     hide btBet;
  1963.     hide btPass;
  1964.     hide btFold;
  1965.     # accept any raise
  1966.     nBet=nBet+nTempBet;
  1967.     # clear raise
  1968.     nTempBet=0;
  1969.     if bDRaise;
  1970.         # dealer raise followed by user pass, moves on
  1971.         if bRound2;
  1972.             call ReconcileBet;
  1973.         else;
  1974.             call UserDrawSelectPrep;
  1975.         end_if;
  1976.     else;
  1977.         # no dealer raise followed by user pass is followed by dealer bet round
  1978.         if bRound2;
  1979.             call DDealerBet2;
  1980.         else;
  1981.             call DDealerBet1;
  1982.         end_if;
  1983.     end_if;
  1984. end;
  1985.  
  1986. function btFold;
  1987.     hide btBet;
  1988.     hide btPass;
  1989.     hide btFold;
  1990.     # don't accept any raise
  1991.     nTempBet=0;
  1992.     bFold=true();
  1993.     call ReconcileBet;
  1994. end;
  1995.  
  1996. function ckHold;
  1997.     # toggle user draw flag
  1998.     bHold[invokersub]=not bHold[invokersub];
  1999. end;
  2000.  
  2001. function btOK;
  2002.     variables;
  2003.         numeric i;
  2004.         numeric n;
  2005.     end;
  2006.     # count how many desired discards
  2007.     i=0;
  2008.     n=0;
  2009.     while i<5;
  2010.         if not bHold[i];
  2011.             n=n+1;
  2012.         end_if;
  2013.         i=i+1;
  2014.     end_while;
  2015.     # only proceed if legal
  2016.     if n<4 or (bfHoldAce(nHand, bHold) and n<5);
  2017.         i=0;
  2018.         while i<5;
  2019.             hide ckHold[i];
  2020.             i=i+1;
  2021.         end_while;
  2022.         hide btOK;
  2023.         call DealerDrawSelect;
  2024.     else;
  2025.         # user confused
  2026.         put lbDWhat, "Check at least 2 to hold (or 1 Ace)";
  2027.     end_if;
  2028. end;
  2029.  
  2030. # INVOKER FUNCTIONS, BET INPUT FORM
  2031.  
  2032. function slBDigit0;
  2033.     call BDisplayBet;
  2034. end;
  2035.  
  2036. function slBDigit1;
  2037.     call BDisplayBet;
  2038. end;
  2039.  
  2040. function btBOK;
  2041.     hide frBet;
  2042.     call ShowForm(1,0);
  2043.     call RedrawHand;
  2044.     if bRound2;
  2045.         call DDealerBet2;
  2046.     else;
  2047.         call DDealerBet1;
  2048.     end_if;
  2049. end;
  2050.  
  2051. function btBReset;
  2052.     BClearBet(bRound2);
  2053. end;
  2054.  
  2055. # INVOKER FUNCTIONS, MESSAGE FORM
  2056.  
  2057. # swaps main and message box frames, and ok button
  2058. #  reverses swap
  2059. #
  2060. function miHelp;
  2061.     variables;
  2062.         numeric i;
  2063.     end;
  2064.     hide frMain;
  2065.     if nForm=0 or nForm=4;
  2066.         call ShowForm(nForm,3);
  2067.     else;
  2068.         i=message_box(0,"Help","Can only view from main screen",
  2069.          "","OK","");
  2070.     end_if;
  2071. end;
  2072.  
  2073. function miAbout;
  2074.     variables;
  2075.         numeric i;
  2076.     end;
  2077.     hide frMain;
  2078.     if nForm=0 or nForm=3;
  2079.         call ShowForm(nForm,4);
  2080.     else;
  2081.         i=message_box(0,"About","Can only view from main screen",
  2082.          "","OK","");
  2083.     end_if;
  2084. end;
  2085.  
  2086. function btMOK;
  2087.     hide frMsgBox;
  2088.     call ShowForm(nForm,0);
  2089. end;
  2090.  
  2091. # INVOKER FUNCTIONS, PREFERENCES FORM
  2092.  
  2093. # swaps main and preferences frame, and ok button
  2094. #  reverses swap
  2095. #
  2096. function miPrefs;
  2097.     variables;
  2098.         numeric i;
  2099.     end;
  2100.     if bAllowPrefs; # and nForm=0;
  2101.         hide frMain;
  2102.         ShowForm(nForm,2);
  2103.     else;
  2104.         i=message_box(0,"Preferences","Can only change at start of new hand",
  2105.          "","OK","");
  2106.     end_if;
  2107. end;
  2108.  
  2109. function slPUnits;
  2110.     get slPUnits,nUnitsI;
  2111.     call PDisplayUnits;
  2112.     call PDisplayPrefStatus;
  2113.     call BDisplayBetLabels();
  2114. end;
  2115.  
  2116. function slPHouseLimit;
  2117.     get slPHouseLimit,nHouseLimitI;
  2118.     call PDisplayHouseLimit;
  2119.     call PDisplayPrefStatus;
  2120.     call BInitBet(bRound2);
  2121.     call DInitMaxBets(nHouseLimit);
  2122. end;
  2123.  
  2124. function btPOK;
  2125.     get ckPRecommendHold, bRecommendHold;
  2126.     get ckPAtStart, bAtStart;
  2127.     hide frMsgBox;
  2128.     call ShowForm(nForm,0);
  2129. end;
  2130.  
  2131. function btPReset;
  2132.     call PDefaultPrefs;
  2133. end;
  2134.  
  2135. # INVOKE AT START
  2136.  
  2137. function Startup;
  2138.     call ArrangeVisObjects;
  2139.     call InitVariables;
  2140.     call PDefaultPrefs; # calls InitBet, InitDealerMaxBets
  2141.     call Welcome;
  2142.     # user starts deal when ready
  2143.     show btDeal;
  2144.     # allow change of units or houselimit only before hand play
  2145.     bAllowPrefs=true();
  2146. end;
  2147.  
  2148.  
  2149.